home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / examples / xaw / paned < prev    next >
Encoding:
Text File  |  1991-09-26  |  1.0 KB  |  33 lines
  1. ;;; -*-Scheme-*-
  2. ;;;
  3. ;;; Paned widget demo
  4.  
  5. (require 'xwidgets)
  6. (load-widgets shell label command paned)
  7.  
  8. (define top (application-initialize 'paned))
  9.  
  10. (define paned (create-managed-widget (find-class 'paned) top))
  11.  
  12. (define w1 (create-managed-widget (find-class 'label) paned))
  13. (set-values! w1 'min 50 'max 50 'label "Fixed size")
  14.  
  15. (define w2 (create-managed-widget (find-class 'command) paned))
  16. (set-values! w2 'show-grip #f 'label "Click to toggle show-grip"
  17.         'preferred-pane-size 30)
  18. (add-callback w2 'callback
  19.   (lambda _
  20.     (set-values! w2 'show-grip (not (car (get-values w2 'show-grip))))))
  21.  
  22. (define w3 (create-managed-widget (find-class 'label) paned))
  23. (set-values! w3 'label "Another child" 'preferred-pane-size 60)
  24.  
  25. (define w4 (create-managed-widget (find-class 'command) paned))
  26. (set-values! w4 'label "Click to report sub-panes" 'preferred-pane-size 60)
  27. (add-callback w4 'callback
  28.   (lambda _
  29.     (format #t "Paned widget has ~s sub-panes~%" (paned-get-num-sub paned))))
  30.  
  31. (realize-widget top)
  32. (context-main-loop (widget-context top))
  33.